home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / database / dbcsrc / dbcreate.frm (.txt) next >
Encoding:
Visual Basic Form  |  1994-03-02  |  18.9 KB  |  498 lines
  1. VERSION 2.00
  2. Begin Form frmMain 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Programatic Database Creation"
  5.    ClientHeight    =   3600
  6.    ClientLeft      =   1230
  7.    ClientTop       =   2460
  8.    ClientWidth     =   6150
  9.    Height          =   4005
  10.    Left            =   1170
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   3600
  15.    ScaleWidth      =   6150
  16.    Top             =   2115
  17.    Width           =   6270
  18.    WindowState     =   2  'Maximized
  19.    Begin CheckBox Check2 
  20.       Alignment       =   1  'Right Justify
  21.       BackColor       =   &H00C0C0C0&
  22.       Caption         =   "Version 1.0:"
  23.       FontBold        =   -1  'True
  24.       FontItalic      =   0   'False
  25.       FontName        =   "MS Sans Serif"
  26.       FontSize        =   8.25
  27.       FontStrikethru  =   0   'False
  28.       FontUnderline   =   -1  'True
  29.       Height          =   495
  30.       Left            =   5400
  31.       TabIndex        =   2
  32.       Top             =   1140
  33.       Width           =   1335
  34.    End
  35.    Begin CheckBox Check1 
  36.       Alignment       =   1  'Right Justify
  37.       BackColor       =   &H00C0C0C0&
  38.       Caption         =   "Encrypted:"
  39.       FontBold        =   -1  'True
  40.       FontItalic      =   0   'False
  41.       FontName        =   "MS Sans Serif"
  42.       FontSize        =   8.25
  43.       FontStrikethru  =   0   'False
  44.       FontUnderline   =   -1  'True
  45.       Height          =   495
  46.       Left            =   5520
  47.       TabIndex        =   1
  48.       Top             =   600
  49.       Width           =   1215
  50.    End
  51.    Begin CommandButton Command2 
  52.       Caption         =   "Translate"
  53.       Height          =   495
  54.       Left            =   4740
  55.       TabIndex        =   3
  56.       Top             =   1860
  57.       Width           =   1215
  58.    End
  59.    Begin CommandButton Command1 
  60.       Caption         =   "Set Names"
  61.       Height          =   495
  62.       Left            =   3420
  63.       TabIndex        =   0
  64.       Top             =   1860
  65.       Width           =   1215
  66.    End
  67.    Begin CommonDialog SaveDlg 
  68.       DialogTitle     =   "Output File"
  69.       Left            =   9060
  70.       Top             =   4800
  71.    End
  72.    Begin CommonDialog OpenDlg 
  73.       DialogTitle     =   "Choose an Access Database"
  74.       InitDir         =   "c:\"
  75.       Left            =   9060
  76.       Top             =   5400
  77.    End
  78.    Begin Line Line2 
  79.       BorderWidth     =   3
  80.       Index           =   2
  81.       X1              =   7920
  82.       X2              =   7920
  83.       Y1              =   3720
  84.       Y2              =   2700
  85.    End
  86.    Begin Line Line2 
  87.       BorderWidth     =   3
  88.       Index           =   1
  89.       X1              =   1320
  90.       X2              =   1320
  91.       Y1              =   3720
  92.       Y2              =   2700
  93.    End
  94.    Begin Line Line2 
  95.       BorderWidth     =   3
  96.       Index           =   0
  97.       X1              =   1320
  98.       X2              =   7920
  99.       Y1              =   3720
  100.       Y2              =   3720
  101.    End
  102.    Begin Line Line1 
  103.       BorderWidth     =   3
  104.       X1              =   1320
  105.       X2              =   7920
  106.       Y1              =   2700
  107.       Y2              =   2700
  108.    End
  109.    Begin Label FileName 
  110.       BackColor       =   &H00E0E0E0&
  111.       Height          =   255
  112.       Left            =   3420
  113.       TabIndex        =   17
  114.       Top             =   2820
  115.       Width           =   3015
  116.    End
  117.    Begin Label Label8 
  118.       BackColor       =   &H00C0C0C0&
  119.       Caption         =   "Status of:"
  120.       FontBold        =   -1  'True
  121.       FontItalic      =   0   'False
  122.       FontName        =   "MS Sans Serif"
  123.       FontSize        =   8.25
  124.       FontStrikethru  =   0   'False
  125.       FontUnderline   =   -1  'True
  126.       Height          =   375
  127.       Left            =   2460
  128.       TabIndex        =   16
  129.       Top             =   2820
  130.       Width           =   915
  131.    End
  132.    Begin Label Label7 
  133.       Alignment       =   2  'Center
  134.       BackColor       =   &H00E0E0E0&
  135.       BorderStyle     =   1  'Fixed Single
  136.       Caption         =   "Use the 'Set Names' button to assign the input/output filenames,  then use the 'Translate' button to create the text file that contains the database definitions for the input database you chose. This is a quick and dirty utility... sorry it ain't pretty."
  137.       FontBold        =   0   'False
  138.       FontItalic      =   0   'False
  139.       FontName        =   "MS Sans Serif"
  140.       FontSize        =   8.25
  141.       FontStrikethru  =   0   'False
  142.       FontUnderline   =   0   'False
  143.       Height          =   495
  144.       Left            =   120
  145.       TabIndex        =   15
  146.       Top             =   3960
  147.       Width           =   9315
  148.    End
  149.    Begin Label Label6 
  150.       Alignment       =   1  'Right Justify
  151.       BackColor       =   &H00C0C0C0&
  152.       Caption         =   "Indexes:"
  153.       FontBold        =   -1  'True
  154.       FontItalic      =   0   'False
  155.       FontName        =   "MS Sans Serif"
  156.       FontSize        =   8.25
  157.       FontStrikethru  =   0   'False
  158.       FontUnderline   =   -1  'True
  159.       Height          =   315
  160.       Left            =   5700
  161.       TabIndex        =   9
  162.       Top             =   3360
  163.       Width           =   855
  164.    End
  165.    Begin Label Label5 
  166.       Alignment       =   1  'Right Justify
  167.       BackColor       =   &H00C0C0C0&
  168.       Caption         =   "Fields:"
  169.       FontBold        =   -1  'True
  170.       FontItalic      =   0   'False
  171.       FontName        =   "MS Sans Serif"
  172.       FontSize        =   8.25
  173.       FontStrikethru  =   0   'False
  174.       FontUnderline   =   -1  'True
  175.       Height          =   315
  176.       Left            =   3600
  177.       TabIndex        =   14
  178.       Top             =   3360
  179.       Width           =   855
  180.    End
  181.    Begin Label Label4 
  182.       Alignment       =   1  'Right Justify
  183.       BackColor       =   &H00C0C0C0&
  184.       Caption         =   "Tables:"
  185.       FontBold        =   -1  'True
  186.       FontItalic      =   0   'False
  187.       FontName        =   "MS Sans Serif"
  188.       FontSize        =   8.25
  189.       FontStrikethru  =   0   'False
  190.       FontUnderline   =   -1  'True
  191.       Height          =   255
  192.       Left            =   1500
  193.       TabIndex        =   13
  194.       Top             =   3360
  195.       Width           =   855
  196.    End
  197.    Begin Label TxtTables 
  198.       BackColor       =   &H00C0C0C0&
  199.       Height          =   255
  200.       Left            =   2400
  201.       TabIndex        =   12
  202.       Top             =   3360
  203.       Width           =   1095
  204.    End
  205.    Begin Label TxtFields 
  206.       BackColor       =   &H00C0C0C0&
  207.       Height          =   315
  208.       Left            =   4500
  209.       TabIndex        =   11
  210.       Top             =   3360
  211.       Width           =   1095
  212.    End
  213.    Begin Label TxtIndexes 
  214.       BackColor       =   &H00C0C0C0&
  215.       Height          =   315
  216.       Left            =   6600
  217.       TabIndex        =   10
  218.       Top             =   3360
  219.       Width           =   1095
  220.    End
  221.    Begin Label OutputName 
  222.       BackColor       =   &H00E0E0E0&
  223.       Height          =   255
  224.       Left            =   6000
  225.       TabIndex        =   8
  226.       Top             =   300
  227.       Width           =   3015
  228.    End
  229.    Begin Label InputName 
  230.       BackColor       =   &H00E0E0E0&
  231.       Height          =   255
  232.       Left            =   1500
  233.       TabIndex        =   7
  234.       Top             =   300
  235.       Width           =   3015
  236.    End
  237.    Begin Label Label3 
  238.       Alignment       =   1  'Right Justify
  239.       BackColor       =   &H00C0C0C0&
  240.       Caption         =   "Output Name:"
  241.       FontBold        =   -1  'True
  242.       FontItalic      =   0   'False
  243.       FontName        =   "MS Sans Serif"
  244.       FontSize        =   8.25
  245.       FontStrikethru  =   0   'False
  246.       FontUnderline   =   -1  'True
  247.       Height          =   315
  248.       Left            =   4740
  249.       TabIndex        =   6
  250.       Top             =   300
  251.       Width           =   1215
  252.    End
  253.    Begin Label Label2 
  254.       Alignment       =   1  'Right Justify
  255.       BackColor       =   &H00C0C0C0&
  256.       Caption         =   "Input Name:"
  257.       FontBold        =   -1  'True
  258.       FontItalic      =   0   'False
  259.       FontName        =   "MS Sans Serif"
  260.       FontSize        =   8.25
  261.       FontStrikethru  =   0   'False
  262.       FontUnderline   =   -1  'True
  263.       Height          =   315
  264.       Left            =   240
  265.       TabIndex        =   5
  266.       Top             =   300
  267.       Width           =   1215
  268.    End
  269.    Begin Label Label1 
  270.       Alignment       =   2  'Center
  271.       BackColor       =   &H00C0C0C0&
  272.       Caption         =   "This program is provided FREE of charge from Dirigible Software. Neither Dirigible Software nor employees of Dirigible Software accepts any responsibility for any damage that this program might cause. Use at your own risk! Comments and Questions WILL be responded to by leaving the appropriate information at (310) 614-9466 or through e-mail at  PROGRAM396@AOL.COM. Source code available upon request."
  273.       Height          =   915
  274.       Left            =   60
  275.       TabIndex        =   4
  276.       Top             =   5940
  277.       Width           =   9495
  278.    End
  279. Dim FNum%
  280. Dim OutFile$
  281. Sub AddLine (Text$)
  282.     If FNum% = -1 Then
  283.         
  284.         '   Poor error checking...
  285.         If OutFile$ = "" Then Exit Sub
  286.         
  287.         FNum% = FreeFile
  288.         
  289.         '   No error checking...
  290.         Open OutFile For Output As FNum%
  291.     End If
  292.     Print #FNum%, Text$
  293. End Sub
  294. '   Copyright: Dirigible Software, 1993-1994.
  295. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  296. '   Check for file existence.
  297. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  298. '                              CHANGE HISTORY
  299. '----------------------------------------------------------------------------
  300. '   Date    |   Description                                         | Inits.
  301. '----------------------------------------------------------------------------
  302. '   08/15/93|   Created.                                            | RDTIII
  303. '----------------------------------------------------------------------------
  304. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  305. Function CheckFile% (FName$)
  306.     Dim FileCheck$, retval%
  307.     retval% = True
  308.     On Error Resume Next
  309.     FileCheck$ = Dir$(FName$)
  310.     If FileCheck$ = "" Then
  311.         retval% = False
  312.     End If
  313.     CheckFile% = retval%
  314. End Function
  315. Sub Command1_Click ()
  316.     '   Provide a common dialog for file selection
  317.     frmMain.OpenDlg.Filename = ""
  318.     frmMain.OpenDlg.Flags = OFN_READONLY
  319.     frmMain.OpenDlg.Filter = "Access Databases |*.MDB"
  320.     frmMain.OpenDlg.Action = 1
  321.     If Not CheckFile((frmMain.OpenDlg.Filename)) Then Exit Sub
  322.     frmMain.InputName.Caption = UCase(frmMain.OpenDlg.Filename)
  323.     frmMain.SaveDlg.Filename = ""
  324. '   Loop on replace fail
  325. SaveDlg:
  326.     frmMain.SaveDlg.Filter = "Text Files |*.TXT"
  327.     frmMain.SaveDlg.Action = 2
  328.     '   Anything?   (not the most efficient way, I know...)
  329.     If frmMain.SaveDlg.Filename = "" Then Exit Sub
  330.     If CheckFile((frmMain.SaveDlg.Filename)) Then
  331.         If (MsgBox("Replace existing file?", 1 Or 48 Or 4096) <> 1) Then GoTo SaveDlg
  332.     End If
  333.     OutFile$ = frmMain.SaveDlg.Filename
  334.     frmMain.OutputName.Caption = UCase(frmMain.SaveDlg.Filename)
  335. End Sub
  336. Sub Command2_Click ()
  337.     '   Vars.
  338.     Dim DB As database      '   Primary DB component
  339.     Dim TB As tabledef      '   "
  340.     Dim FD As Field         '   "
  341.     Dim IDX As Index        '   "
  342.     Dim DBName$             '   DB Name (duh)
  343.     Dim DBColl%             '   DB Collating order
  344.     Dim Options&            '   DB Options (Version &&/|| Encrypted)
  345.     Dim Encrypt%, Version%  '   ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  346.     Dim TBName$             '   Table name, as it was read
  347.     Dim FDName$             '   Field name, "
  348.     Dim IDXName$            '   Index name, "
  349.     Dim TCnt%               '   Number of tables in DB
  350.     Dim FDCnt%              '   Number of fields per table
  351.     Dim IDXCnt%             '   Number of indexes per table
  352.     Dim i%, j%              '   Loop vars.
  353.     Static UTbl%, UFld%, UIDX%  '   # processed
  354.     Const OFN_READONLY = &H1&
  355.     '   Quick check...
  356.     If frmMain.InputName.Caption = "" Or frmMain.OutputName.Caption = "" Then Exit Sub
  357.     frmMain.MousePointer = 11
  358.     frmMain.Filename.Caption = frmMain.InputName.Caption
  359.     frmMain.TxtTables.Caption = UTbl%
  360.     frmMain.TxtFields.Caption = UFld%
  361.     frmMain.TxtIndexes.Caption = UIDX%
  362.     DoEvents
  363.     '   No time for error checking...!
  364.     Set DB = OpenDatabase(frmMain.OpenDlg.Filename)
  365.     '   Count the number tables (includes system tables)
  366.     TCnt% = DB.TableDefs.Count - 1
  367.     DBName$ = DB.Name
  368.     DBColl% = DB.CollatingOrder
  369.     '   Create the header
  370.     AddLine ""
  371.     AddLine "'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''"
  372.     AddLine "'  Programatic database creation procedure.                                 '"
  373.     AddLine "'                                                                           '"
  374.     AddLine "'  Dirigible Software - R. Donald Thompson, III                             '"
  375.     AddLine "'  Version: November 1993                                                   '"
  376.     AddLine "'  Questions or Comments: (310) 614-9466 / PROGRAM396@AOL.COM"              '"
  377.     AddLine "'                                                                           '"
  378.     AddLine "'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''"
  379.     AddLine "'"
  380.     AddLine "'  Database: " & frmMain.OpenDlg.Filetitle
  381.     AddLine "'  Tables  : " & TCnt% - 5
  382.     AddLine "'  Date    : " & Now
  383.     AddLine "'"
  384.     AddLine "''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''"
  385.     AddLine "Function DBCreate" & Left$(frmMain.OpenDlg.Filetitle, Len(frmMain.OpenDlg.Filetitle) - 4) & "() As Integer"
  386.     AddLine ""
  387.     AddLine "   DBCreate = True     '   Return value."
  388.     AddLine ""
  389.     AddLine "   Dim DB As Database  '   Database to create."
  390.     AddLine ""
  391.     '   Generic stuff...
  392.     AddLine "   '   You will probably want to add error handling here, and set the return"
  393.     AddLine "   '   value accordingly on failure, etc., i.e.,"
  394.     AddLine "   '   If FileExist(" & Chr(34) & DBName & Chr(34) & ") then"
  395.     AddLine "   '       Kill " & Chr(34) & DBName & Chr(34)
  396.     AddLine "   '       ..."
  397.     AddLine "   '   Endif"
  398.     AddLine ""
  399.     AddLine "   '   Create the database..."
  400.     '   Define/establish options
  401.     Encrypt% = IIf(frmMain.Check1 <> 0, 2, 0)
  402.     Version% = IIf(frmMain.Check2 <> 0, 1, 0)
  403.     '   'and' them together, regardless...
  404.     Options& = Encrypt% + Version%
  405.     '-----------------------------------
  406.     '   NOTE:   LangID... -> HARD-CODED!
  407.     '-----------------------------------
  408.     If Options& <> 0 Then
  409.         AddLine "   Set db = CreateDatabase(" & Chr(34) & DBName$ & Chr(34) & ", " & Chr(34) & ";LANGID=0x0809;CP=1252;COUNTRY=0" & Chr(34) & ", " & Options& & ")"
  410.     Else
  411.         AddLine "   Set db = CreateDatabase(" & Chr(34) & DBName$ & Chr(34) & ", " & Chr(34) & ";LANGID=0x0809;CP=1252;COUNTRY=0" & Chr(34) & ")"
  412.     End If
  413.     AddLine ""
  414.     '   Loop for all of the tables in the DB
  415.     For i% = 0 To TCnt%
  416.         Set TB = DB(i%)
  417.         TBName$ = TB.Name
  418.         '   System table?
  419.         If Left$(TBName$, 4) <> "MSys" Then
  420.             UTbl% = UTbl% + 1
  421.             frmMain.TxtTables.Caption = UTbl%
  422.             AddLine ""
  423.             AddLine "''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''"
  424.             AddLine "   '   Table: " & UCase(TBName)
  425.             FDCnt% = TB.Fields.Count
  426.             AddLine "   '   Number of fields: " & FDCnt%
  427.             IDXCnt% = TB.Indexes.Count
  428.             AddLine "   '   Number of indexes: " & IDXCnt%
  429.             AddLine "''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''"
  430.             AddLine ""
  431.             AddLine "   Dim Tbl" & UTbl% & " As New TableDef"
  432.             AddLine ""
  433.             AddLine "   '   Set the table name..."
  434.             AddLine "   Tbl" & UTbl% & ".Name = " & Chr(34) & UCase(TBName$) & Chr(34)
  435.             AddLine ""
  436.             AddLine "   '   Build Tables..."
  437.             AddLine ""
  438.             
  439.             '   Loop for all of the tables
  440.             For j = 0 To FDCnt% - 1
  441.                 UFld% = UFld% + 1
  442.                 frmMain.TxtFields.Caption = UFld%
  443.                 Set FD = TB.Fields(j)
  444.                 AddLine "   Dim Fld" & UFld & " As New Field"
  445.                 AddLine "   Fld" & UFld% & ".Name = " & Chr(34) & FD.Name & Chr(34)
  446.                 AddLine "   Fld" & UFld% & ".Type = " & FD.Type
  447.                 AddLine "   Fld" & UFld% & ".Size = " & FD.Size
  448.                 AddLine "   Fld" & UFld% & ".Attributes = " & FD.Attributes
  449.                 AddLine "   Tbl" & UTbl% & ".Fields.Append " & "Fld" & UFld%
  450.                 AddLine ""
  451.             Next
  452.             AddLine "   '   Build Indexes..."
  453.             AddLine ""
  454.             
  455.             '   Loop for all of the indexes
  456.             For j% = 0 To IDXCnt% - 1
  457.                 UIDX% = UIDX% + 1
  458.                 frmMain.TxtIndexes.Caption = UIDX%
  459.                 DoEvents
  460.                 Set IDX = TB.Indexes(j%)
  461.                 AddLine "   Dim Idx" & UIDX & " As New Index"
  462.                 AddLine "   Idx" & UIDX% & ".Name   = " & Chr(34) & IDX.Name & Chr(34)
  463.                 AddLine "   Idx" & UIDX% & ".Primary= " & IDX.Primary
  464.                 AddLine "   Idx" & UIDX% & ".Unique = " & IDX.Unique
  465.                 AddLine "   Idx" & UIDX% & ".Fields = " & Chr(34) & IDX.Fields & Chr(34)
  466.                 AddLine "   Tbl" & UTbl% & ".Indexes.Append " & "Idx" & UIDX%
  467.                 AddLine ""
  468.             Next
  469.             AddLine "''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''"
  470.             AddLine "'      Create table: " & UCase(TBName$) & "..."
  471.             AddLine "''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''"
  472.             AddLine "   DB.TableDefs.Append Tbl" & UTbl%
  473.         End If
  474.     Next
  475.     AddLine ""
  476.     AddLine "   '   End of database translation."
  477.     AddLine "   '   ----------------------------"
  478.     AddLine "   '   Total Tables    : " & UTbl%
  479.     AddLine "   '   Total Fields    : " & UFld%
  480.     AddLine "   '   Total Indexes   : " & UIDX%
  481.     AddLine ""
  482.     AddLine "End Sub"
  483.     Close #FNum%
  484.     FNum% = 0
  485.     frmMain.InputName.Caption = ""
  486.     frmMain.OutputName.Caption = ""
  487.     frmMain.TxtTables.Caption = UTbl%
  488.     frmMain.TxtFields.Caption = UFld%
  489.     frmMain.TxtIndexes.Caption = UIDX%
  490.     UTbl% = 0
  491.     UFld% = 0
  492.     UIDX% = 0
  493.     frmMain.MousePointer = 0
  494. End Sub
  495. Sub Form_Load ()
  496.     FNum% = -1
  497. End Sub
  498.